home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / Resources / CutePDF 2.3 / converter.exe / GNUGS / GS_LEV2.PS < prev    next >
Text File  |  2003-04-01  |  32KB  |  935 lines

  1. %    Copyright (C) 1990, 2000 Aladdin Enterprises.  All rights reserved.
  2. % This software is provided AS-IS with no warranty, either express or
  3. % implied.
  4. % This software is distributed under license and may not be copied,
  5. % modified or distributed except as expressly authorized under the terms
  6. % of the license contained in the file LICENSE in this distribution.
  7. % For more information about licensing, please refer to
  8. % http://www.ghostscript.com/licensing/. For information on
  9. % commercial licensing, go to http://www.artifex.com/licensing/ or
  10. % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  11. % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  12.  
  13. % $Id: gs_lev2.ps,v 1.7.2.4.2.2 2003/03/31 13:02:22 giles Exp $
  14. % Initialization file for Level 2 functions.
  15. % When this is run, systemdict is still writable,
  16. % but (almost) everything defined here goes into level2dict.
  17.  
  18. level2dict begin
  19.  
  20. % ------ System and user parameters ------ %
  21.  
  22. % User parameters must obey save/restore, and must also be maintained
  23. % per-context.  We implement the former, and some of the latter, here
  24. % with PostScript code.  NOTE: our implementation assumes that user
  25. % parameters change only as a result of setuserparams -- that there are
  26. % no user parameters that are ever changed dynamically by the interpreter
  27. % (although the interpreter may adjust the value presented to setuserparams)
  28. %
  29. % There are two types of user parameters: those which are actually
  30. % maintained in the interpreter, and those which exist only at the
  31. % PostScript level.  We maintain the current state of both types in
  32. % a read-only local dictionary named userparams, defined in systemdict.
  33. % In a multi-context system, each context has its own copy of this
  34. % dictionary.  In addition, there is a constant dictionary named
  35. % psuserparams where each key is the name of a user parameter that exists
  36. % only in PostScript and the value is a procedure to check that the value
  37. % is legal: setuserparams uses this for checking the values.
  38. % setuserparams updates userparams explicitly, in addition to setting
  39. % any user parameters in the interpreter; thus we can use userparams
  40. % to reset those parameters after a restore or a context switch.
  41. % NOTE: the name userparams is known to the interpreter, and in fact
  42. % the interpreter creates the userparams dictionary.
  43.  
  44. % Check parameters that are managed at the PostScript level.
  45. /.checkparamtype {        % <newvalue> <type> .checkparamtype <bool>
  46.   exch type eq
  47. } .bind def
  48. /.checksetparams {        % <newdict> <opname> <checkdict>
  49.                 %   .checksetparams <newdict>
  50.   2 index {
  51.         % Stack: newdict opname checkdict key newvalue
  52.     3 copy 3 1 roll .knownget {
  53.       exec not {
  54.     pop pop pop load /typecheck signalerror
  55.       } if
  56.       dup type /stringtype eq {
  57.     dup rcheck not {
  58.       pop pop pop load /invalidaccess signalerror
  59.     } if
  60.       } if
  61.     } {
  62.       pop
  63.     } ifelse pop pop
  64.   } forall pop pop
  65. } .bind def    % not odef, shouldn't reset stacks
  66.  
  67. % currentuser/systemparams creates and returns a dictionary in the
  68. % current VM.  The easiest way to make this work is to copy any composite
  69. % PostScript-level parameters to global VM.  Currently we have strings
  70. % as well as arrays. For arrays, we also need to copy any contents that
  71. % are in VM. Also copying string parameters insures the contents won't
  72. % be changed. Also be careful to preserve 'executable' state.
  73. /.copyparam {            % <value> .copyparam <value'>
  74.   dup type /arraytype eq {
  75.     .currentglobal true .setglobal exch 
  76.     dup xcheck exch        % original executable state
  77.     [ exch {
  78.       dup type dup /arraytype eq exch /stringtype eq or {
  79.         .copyparam    % recurse to handle composite array elements
  80.       } if
  81.     } forall ]
  82.     exch { cvx } if        % set executable state
  83.     exch .setglobal
  84.   } if
  85.   dup type /stringtype eq {
  86.     .currentglobal true .setglobal
  87.     1 index length string exch .setglobal
  88.     copy readonly
  89.   } if
  90. } .bind def
  91.  
  92. % Some user parameters are managed entirely at the PostScript level.
  93. % We take care of that here.
  94. systemdict begin
  95. /psuserparams 48 dict def
  96. /getuserparam {            % <name> getuserparam <value>
  97.   /userparams .systemvar 1 index get exch pop
  98. } odef
  99. % Fill in userparams (created by the interpreter) with current values.
  100. mark .currentuserparams
  101. counttomark 2 idiv {
  102.   userparams 3 1 roll put
  103. } repeat pop
  104. /.definepsuserparam {        % <name> <value> .definepsuserparam -
  105.   psuserparams 3 copy pop
  106.   type cvlit /.checkparamtype cvx 2 packedarray cvx put
  107.   userparams 3 1 roll put
  108. } .bind def
  109. end
  110. /currentuserparams {        % - currentuserparams <dict>
  111.   /userparams .systemvar dup length dict .copydict
  112. } odef
  113. /setuserparams {        % <dict> setuserparams -
  114.     % Check that we will be able to set the PostScript-level
  115.     % user parameters.
  116.   /setuserparams /psuserparams .systemvar .checksetparams
  117.     % Set the C-level user params.  If this succeeds, we know that
  118.     % the password check succeeded.
  119.   dup .setuserparams
  120.     % Now set the PostScript-level params.
  121.     % The interpreter may have adjusted the values of some of the
  122.     % parameters, so we have to read them back.
  123.   dup {
  124.     /userparams .systemvar 2 index known {
  125.       psuserparams 2 index known not {
  126.     pop dup .getuserparam
  127.       } if
  128.       .copyparam
  129.       /userparams .systemvar 3 1 roll .forceput  % userparams is read-only
  130.     } {
  131.       pop pop
  132.     } ifelse
  133.   } forall
  134.     % A context switch might have occurred during the above loop,
  135.     % causing the interpreter-level parameters to be reset.
  136.     % Set them again to the new values.  From here on, we are safe,
  137.     % since a context switch will consult userparams.
  138.   .setuserparams
  139. } .bind odef
  140. % Initialize user parameters managed here.
  141. /JobName () .definepsuserparam
  142.  
  143. % Restore must restore the user parameters.
  144. % (Since userparams is in local VM, save takes care of saving them.)
  145. /restore {        % <save> restore -
  146.   //restore /userparams .systemvar .setuserparams
  147. } .bind odef
  148.  
  149. % The pssystemparams dictionary holds some system parameters that
  150. % are managed entirely at the PostScript level.
  151. systemdict begin
  152. currentdict /pssystemparams known not {
  153.   /pssystemparams 40 dict readonly def
  154. } if
  155. /getsystemparam {        % <name> getsystemparam <value>
  156.   //pssystemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse
  157. } odef
  158. end
  159. /currentsystemparams {        % - currentsystemparams <dict>
  160.   mark .currentsystemparams //pssystemparams { } forall .dicttomark
  161. } odef
  162. /setsystemparams {        % <dict> setsystemparams -
  163.     % Check that we will be able to set the PostScript-level
  164.     % system parameters.
  165.    /SAFETY .systemvar /safe get {
  166.      % SAFER mode disallows some changes
  167.      [ /GenericResourceDir /FontResourceDir /GenericResourcePathSep ] {
  168.        2 copy .knownget {
  169.      exch //pssystemparams exch .knownget {
  170.            ne { /setsystemparams /invalidaccess signalerror } if
  171.          } {
  172.            pop
  173.          } ifelse
  174.        } {
  175.          pop
  176.        } ifelse
  177.      } forall
  178.    } if
  179.    /setsystemparams //pssystemparams mark exch {
  180.      type cvlit /.checkparamtype cvx 2 packedarray cvx
  181.    } forall .dicttomark .checksetparams
  182.     % Set the C-level system params.  If this succeeds, we know that
  183.     % the password check succeeded.
  184.    dup .setsystemparams
  185.     % Now set the PostScript-level params.  We must copy local strings
  186.     % into global VM.
  187.    dup
  188.     { //pssystemparams 2 index known
  189.        {        % Stack: key newvalue
  190.      .copyparam
  191.      //pssystemparams 3 1 roll .forceput    % pssystemparams is read-only
  192.        }
  193.        { pop pop
  194.        }
  195.       ifelse
  196.     }
  197.    forall pop
  198. } .bind odef
  199.  
  200. % Initialize the passwords.
  201. % NOTE: the names StartJobPassword and SystemParamsPassword are known to
  202. % the interpreter, and must be bound to noaccess strings.
  203. % The length of these strings must be max_password (iutil2.h) + 1.
  204. /StartJobPassword 65 string noaccess def
  205. /SystemParamsPassword 65 string noaccess def
  206.  
  207. % Redefine cache parameter setting to interact properly with userparams.
  208. /setcachelimit {
  209.   mark /MaxFontItem 2 index .dicttomark setuserparams pop
  210. } .bind odef
  211. /setcacheparams {
  212.     % The MaxFontCache parameter is a system parameter, which we might
  213.     % not be able to set.  Fortunately, this doesn't matter, because
  214.     % system parameters don't have to be synchronized between this code
  215.     % and the VM.
  216.   counttomark 1 add copy setcacheparams
  217.   currentcacheparams    % mark size lower upper
  218.     3 -1 roll pop
  219.     /MinFontCompress 3 1 roll
  220.     /MaxFontItem exch
  221.   .dicttomark setuserparams
  222.   cleartomark
  223. } .bind odef
  224.  
  225. % Add bogus user and system parameters to satisfy badly written PostScript
  226. % programs that incorrectly assume the existence of all the parameters
  227. % listed in Appendix C of the Red Book.  Note that some of these may become
  228. % real parameters later: code near the end of gs_init.ps takes care of
  229. % removing any such parameters from ps{user,system}params.
  230.  
  231. % psuserparams
  232.   /MaxFormItem 100000 .definepsuserparam
  233.   /MaxPatternItem 20000 .definepsuserparam
  234.   /MaxScreenItem 48000 .definepsuserparam
  235.   /MaxUPathItem 5000 .definepsuserparam
  236.  
  237. % File Access Permission parameters
  238.   .currentglobal true .setglobal
  239.   /.checkFilePermitparams {
  240.     type /arraytype eq {
  241.       currentuserparams /LockFilePermissions get {
  242.         5 { pop } repeat /setuserparams /invalidaccess signalerror
  243.       }
  244.       if
  245.     } {
  246.       5 { pop } repeat /setuserparams /typecheck signalerror
  247.     }
  248.     ifelse
  249.     true
  250.   } .bind def
  251. % Initialize the File Permission access control to wide open
  252. % These will only be accessed via current/set userparams.
  253. % Values are a string containing multiple nul terminated path strings
  254.   /PermitFileReading dup [ (*) ] .definepsuserparam
  255.     psuserparams exch /.checkFilePermitparams load put
  256.   /PermitFileWriting dup [ (*) ] .definepsuserparam
  257.     psuserparams exch /.checkFilePermitparams load put
  258.   /PermitFileControl dup [ (*) ] .definepsuserparam
  259.     psuserparams exch /.checkFilePermitparams load put
  260.   .setglobal
  261.  
  262. pssystemparams begin
  263.   /CurDisplayList 0 .forcedef
  264.   /CurFormCache 0 .forcedef
  265.   /CurOutlineCache 0 .forcedef
  266.   /CurPatternCache 0 .forcedef
  267.   /CurUPathCache 0 .forcedef
  268.   /CurScreenStorage 0 .forcedef
  269.   /CurSourceList 0 .forcedef
  270.   /DoPrintErrors false .forcedef
  271.   /MaxDisplayList 140000 .forcedef
  272.   /MaxFormCache 100000 .forcedef
  273.   /MaxOutlineCache 65000 .forcedef
  274.   /MaxPatternCache 100000 .forcedef
  275.   /MaxUPathCache 300000 .forcedef
  276.   /MaxScreenStorage 84000 .forcedef
  277.   /MaxSourceList 25000 .forcedef
  278.   /RamSize 4194304 .forcedef
  279. end
  280.  
  281. % Define the procedures for handling comment scanning.  The names
  282. % %ProcessComment and %ProcessDSCComment are known to the interpreter.
  283. % These procedures take the file and comment string and file as operands.
  284. /.checkprocesscomment {
  285.   dup null eq {
  286.     pop true
  287.   } {
  288.     dup xcheck {
  289.       type dup /arraytype eq exch /packedarraytype eq or
  290.     } {
  291.       pop false
  292.     } ifelse
  293.   } ifelse
  294. } .bind def
  295. /ProcessComment null .definepsuserparam
  296. psuserparams /ProcessComment {.checkprocesscomment} put
  297. (%ProcessComment) cvn {
  298.   /ProcessComment getuserparam
  299.   dup null eq { pop pop pop } { exec } ifelse
  300. } bind def
  301. /ProcessDSCComment null .definepsuserparam
  302. psuserparams /ProcessDSCComment {.checkprocesscomment} put
  303. (%ProcessDSCComment) cvn {
  304.   /ProcessDSCComment getuserparam
  305.   dup null eq { pop pop pop } { exec } ifelse
  306. } bind def
  307.  
  308. % ------ Miscellaneous ------ %
  309.  
  310. (<<) cvn            % - << -mark-
  311.   /mark load def
  312. (>>) cvn            % -mark- <key1> <value1> ... >> <dict>
  313.   /.dicttomark load def
  314. /languagelevel 2 def
  315. % When running in Level 2 mode, this interpreter is supposed to be
  316. % compatible with Adobe version 2017.
  317. /version (2017) readonly def
  318.  
  319. % If binary tokens are supported by this interpreter,
  320. % set an appropriate default binary object format.
  321. /setobjectformat where
  322.  { pop
  323.    /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
  324.    /ByteOrder getsystemparam { 1 add } if
  325.    setobjectformat
  326.  } if
  327.  
  328. % Aldus Freehand versions 2.x check for the presence of the
  329. % setcolor operator, and if it is missing, substitute a procedure.
  330. % Unfortunately, the procedure takes different parameters from
  331. % the operator.  As a result, files produced by this application
  332. % cause an error if the setcolor operator is actually defined
  333. % and 'bind' is ever used.  Aldus fixed this bug in Freehand 3.0,
  334. % but there are a lot of files created by the older versions
  335. % still floating around.  Therefore, at Adobe's suggestion,
  336. % we implement the following dreadful hack in the 'where' operator:
  337. %      If the key is /setcolor, and
  338. %        there is a dictionary named FreeHandDict, and
  339. %        currentdict is that dictionary,
  340. %      then "where" consults only that dictionary and not any other
  341. %        dictionaries on the dictionary stack.
  342. .wheredict /setcolor {
  343.   /FreeHandDict .where {
  344.     /FreeHandDict get currentdict eq {
  345.       pop currentdict /setcolor known { currentdict true } { false } ifelse
  346.     } {
  347.       .where
  348.     } ifelse
  349.   } {
  350.     .where
  351.   } ifelse
  352. } bind put
  353.  
  354. % ------ Virtual memory ------ %
  355.  
  356. /currentglobal            % - currentglobal <bool>
  357.   /currentshared load def
  358. /gcheck                % <obj> gcheck <bool>
  359.   /scheck load def
  360. /setglobal            % <bool> setglobal -
  361.   /setshared load def
  362. % We can make the global dictionaries very small, because they auto-expand.
  363. /globaldict currentdict /shareddict .knownget not { 4 dict } if def
  364. /GlobalFontDirectory SharedFontDirectory def
  365.  
  366. % VMReclaim and VMThreshold are user parameters.
  367. /setvmthreshold {        % <int> setvmthreshold -
  368.   mark /VMThreshold 2 index .dicttomark setuserparams pop
  369. } odef
  370. /vmreclaim {            % <int> vmreclaim -
  371.   dup 0 gt {
  372.     .vmreclaim
  373.   } {
  374.     mark /VMReclaim 2 index .dicttomark setuserparams pop
  375.   } ifelse
  376. } odef
  377. -1 setvmthreshold
  378.  
  379. % ------ IODevices ------ %
  380.  
  381. /.getdevparams where {
  382.   pop /currentdevparams {    % <iodevice> currentdevparams <dict>
  383.     .getdevparams .dicttomark
  384.   } odef
  385. } if
  386. /.putdevparams where {
  387.   pop /setdevparams {        % <iodevice> <dict> setdevparams -
  388.     mark 1 index { } forall counttomark 2 add index
  389.     .putdevparams pop pop
  390.   } odef
  391. } if
  392.  
  393. % ------ Job control ------ %
  394.  
  395. serverdict begin
  396.  
  397. % We could protect the job information better, but we aren't attempting
  398. % (currently) to protect ourselves against maliciousness.
  399.  
  400. /.jobsave null def        % top-level save object
  401. /.jobsavelevel 0 def        % save depth of job (0 if .jobsave is null,
  402.                 % 1 otherwise)
  403. /.adminjob true def        % status of current unencapsulated job
  404.  
  405. end        % serverdict
  406.  
  407. % Because there may be objects on the e-stack created since the job save,
  408. % we have to clear the e-stack before doing the end-of-job restore.
  409. % We do this by executing a 2 .stop, which is caught by the 2 .stopped
  410. % in .runexec; we leave on the o-stack a procedure to execute aftewards.
  411. %
  412. %**************** The definition of startjob is not complete yet, since
  413. % it doesn't reset stdin/stdout.
  414. /.startnewjob {            % <exit_bool> <password_level>
  415.                 %   .startnewjob -
  416.     serverdict /.jobsave get dup null eq { pop } { restore } ifelse
  417.     exch {
  418.             % Unencapsulated job
  419.       serverdict /.jobsave null put
  420.       serverdict /.jobsavelevel 0 put
  421.       serverdict /.adminjob 3 -1 roll 1 gt put
  422.         % The Adobe documentation doesn't say what happens to the
  423.         % graphics state stack in this case, but an experiment
  424.         % produced results suggesting that a grestoreall occurs.
  425.       grestoreall
  426.     } {
  427.             % Encapsulated job
  428.       pop
  429.       serverdict /.jobsave save put
  430.       serverdict /.jobsavelevel 1 put
  431.     } ifelse
  432.         % Reset the interpreter state.
  433.   clear cleardictstack
  434.   initgraphics
  435.   false setglobal
  436. } bind def
  437. /.startjob {            % <exit_bool> <password> <finish_proc>
  438.                 %   .startjob <ok_bool>
  439.   vmstatus pop pop serverdict /.jobsavelevel get eq
  440.   2 index .checkpassword 0 gt and {
  441.     exch .checkpassword exch count 3 roll count 3 sub { pop } repeat
  442.     cleardictstack
  443.         % Reset the e-stack back to the 2 .stopped in .runexec,
  444.         % passing the finish_proc to be executed afterwards.
  445.     2 .stop
  446.   } {        % Password check failed
  447.     pop pop pop false
  448.   } ifelse
  449. } odef
  450. /startjob {            % <exit_bool> <password> startjob <ok_bool>
  451.     % This is a hack.  We really need some way to indicate explicitly
  452.     % to the interpreter that we are under control of a job server.
  453.   .userdict /quit /stop load put
  454.   { .startnewjob true } .startjob
  455. } odef
  456.  
  457. systemdict begin
  458. /quit {                % - quit -
  459.   //systemdict begin serverdict /.jobsave get null eq
  460.    { end //quit }
  461.    { /quit load /invalidaccess /signalerror load end exec }
  462.   ifelse
  463. } bind odef
  464. end
  465.  
  466. % We would like to define exitserver as a procedure, using the code
  467. % that the Red Book says is equivalent to it.  However, since startjob
  468. % resets the exec stack, we can't do this, because control would never
  469. % proceed past the call on startjob if the exitserver is successful.
  470. % Instead, we need to construct exitserver out of pieces of startjob.
  471.  
  472. serverdict begin
  473.  
  474. /exitserver {            % <password> exitserver -
  475.   true exch { .startnewjob } .startjob not {
  476.     /exitserver /invalidaccess signalerror
  477.   } if
  478. } bind def
  479.  
  480. end        % serverdict
  481.  
  482. % ------ Compatibility ------ %
  483.  
  484. % In Level 2 mode, the following replace the definitions that gs_statd.ps
  485. % installs in statusdict and serverdict.
  486. % Note that statusdict must be allocated in local VM.
  487. % We don't bother with many of these yet.
  488.  
  489. /.dict1 { exch mark 3 1 roll .dicttomark } bind def
  490.  
  491. currentglobal false setglobal 25 dict exch setglobal begin
  492. currentsystemparams
  493.  
  494. % The following do not depend on the presence of setpagedevice.
  495. /buildtime 1 index /BuildTime get def
  496. /byteorder 1 index /ByteOrder get def
  497. /checkpassword { .checkpassword 0 gt } bind def
  498. dup /DoStartPage known
  499.  { /dostartpage { /DoStartPage getsystemparam } bind def
  500.    /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
  501.  } if
  502. dup /StartupMode known
  503.  { /dosysstart { /StartupMode getsystemparam 0 ne } bind def
  504.    /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
  505.  } if
  506. %****** Setting jobname is supposed to set userparams.JobName, too.
  507. /jobname { /JobName getuserparam } bind def
  508. /jobtimeout { /JobTimeout getuserparam } bind def
  509. /ramsize { /RamSize getsystemparam } bind def
  510. /realformat 1 index /RealFormat get def
  511. dup /PrinterName known
  512.  { /setprintername { /PrinterName .dict1 setsystemparams } bind def
  513.  } if
  514. /printername
  515.  { currentsystemparams /PrinterName .knownget not { () } if exch copy
  516.  } bind def
  517. currentuserparams /WaitTimeout known
  518.  { /waittimeout { /WaitTimeout getuserparam } bind def
  519.  } if
  520.  
  521. % The following do require setpagedevice.
  522. /.setpagedevice where { pop } { (%END PAGEDEVICE) .skipeof } ifelse
  523. /defaulttimeouts
  524.  { currentsystemparams dup
  525.    /JobTimeout .knownget not { 0 } if
  526.    exch /WaitTimeout .knownget not { 0 } if
  527.    currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
  528.  } bind def
  529. /margins
  530.  { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse
  531.  } bind def
  532. /pagemargin
  533.  { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse
  534.  } bind def
  535. /pageparams
  536.  { currentpagedevice
  537.    dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch
  538.    dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll
  539.    /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll
  540.  } bind def
  541. /setdefaulttimeouts
  542.  { exch mark /ManualFeedTimeout 3 -1 roll
  543.    /Policies mark /ManualFeedTimeout 1 .dicttomark
  544.    .dicttomark setpagedevice
  545.    /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
  546.  } bind def
  547. /.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
  548. /setduplexmode { /Duplex .dict1 setpagedevice } bind def
  549. /setmargins
  550.  { exch 2 array astore /Margins .dict1 setpagedevice
  551.  } bind def
  552. /setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def
  553. /setpageparams
  554.  { mark /PageSize 6 -2 roll
  555.    4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore
  556.    /Orientation 5 -1 roll ORIENT1 { 1 xor } if
  557.    /PageOffset counttomark 2 add -1 roll 0 2 array astore
  558.    .dicttomark setpagedevice
  559.  } bind def
  560. /setresolution
  561.  { dup 2 array astore /HWResolution .dict1 setpagedevice
  562.  } bind def
  563. %END PAGEDEVICE
  564.  
  565. % The following are not implemented yet.
  566. %manualfeed
  567. %manualfeedtimeout
  568. %pagecount
  569. %pagestackorder
  570. %setpagestackorder
  571.  
  572. pop        % currentsystemparams
  573.  
  574. % Flag the current dictionary so it will be swapped when we
  575. % change language levels.  (See zmisc2.c for more information.)
  576. /statusdict currentdict def
  577.  
  578. currentdict end
  579. /statusdict exch .forcedef    % statusdict is local, systemdict is global
  580.  
  581. % The following compatibility operators are in systemdict.  They are
  582. % defined here, rather than in gs_init.ps, because they require the
  583. % resource machinery.
  584.  
  585. /devforall {        % <pattern> <proc> <scratch> devforall -
  586.   exch {
  587.     1 index currentdevparams
  588.     /Type .knownget { /FileSystem eq } { false } ifelse
  589.     { exec } { pop pop } ifelse
  590.   } /exec load 3 packedarray cvx exch
  591.   (*) 3 1 roll ppstack flush /IODevice resourceforall
  592. } odef
  593. /devstatus {        % <(%disk*%)> devstatus <searchable> <writable>
  594.             %   <hasNames> <mounted> <removable> <searchOrder>
  595.             %   <freePages> <size> true
  596.             % <string> devstatus false
  597.   dup length 5 ge {
  598.     dup 0 5 getinterval (%disk) eq {
  599.       dup /IODevice resourcestatus {
  600.     pop pop dup currentdevparams
  601.     dup /Searchable get
  602.     exch dup /Writable get
  603.     exch dup /HasNames get
  604.     exch dup /Mounted get
  605.     exch dup /Removable get
  606.     exch dup /SearchOrder get
  607.     exch dup /Free get
  608.     exch /LogicalSize get
  609.     9 -1 roll pop true
  610.       } {
  611.     pop false
  612.       } ifelse
  613.     } {
  614.       pop false
  615.     } ifelse
  616.   } {
  617.     pop false
  618.   } ifelse
  619. } odef
  620.  
  621. % ------ Color spaces ------ %
  622.  
  623. % Attempt to convert a tint transformation procedure to a type 4 Function.
  624. % The value <m> is the number  of function inputs
  625. % The current color space defines the number of function output values.
  626. % The current color space will be the alternate color space for the function.
  627. % If the conversion fails then build a color cube function.
  628.  
  629. /.converttinttransform {    % [.. .. .. proc ] <m>
  630.                 %   .converttinttransform [.. .. .. proc']
  631.   .currentglobal            % Save current global memory state
  632.   2 index gcheck .setglobal        % Set gobal mode to match the array's mode
  633.   4 dict                % Build a dictionary for our type 4 function
  634.     dup /FunctionType 4 put        % Set FunctionType
  635.     dup /Function 5 index 3 get put    % Set function expression
  636.         % Stack: orig m global func
  637.     dup /Domain
  638.     [ 5 index {0 1} repeat ] put    % set Domain values
  639.     dup /Range
  640.     [ mark currentcolor counttomark
  641.     dup 2 add 1 roll cleartomark    % # of components in alternate space
  642.     {0 1} repeat ] put            % Set Range values
  643.   { .buildfunction } .internalstopped    % Try to build a type 4 function
  644.   dup
  645.   {                % type 4 function failed - Collect data for a color cube
  646.     pop                    % Remove duplicate copy of stopped status
  647.     pop                    % Remove invalid type 4 function
  648.     1 index                % Get number of inputs
  649.     mark currentcolor counttomark    % Count number of output colors
  650.     dup 2 add 1 roll cleartomark    % # of components in alternate space
  651.     4 index 3 get            % Get tint transform function
  652.     { .buildcolorcube } .internalstopped 
  653.   } if
  654.   {                    % Color cube build failed
  655.     pop pop pop exch pop exch pop    % Remove unused parameters
  656.     .setglobal                % Restore global state
  657.   } {                    % Function build succeeded - install function
  658.                     % Stack: orig m global func
  659.     3 -1 roll pop            % Stack: orig global func
  660.     2 index 4 array copy dup 3 4 -1 roll put
  661.     exch .setglobal exch pop
  662.   } ifelse
  663. } bind def
  664.  
  665. % Define the setcolorspace procedures:
  666. %    <colorspace> proc <colorspace'|null>
  667. % We have to define the dictionary first, so it can be bound into the
  668. % implementation procedure, but we can't populate it until the procedure
  669. % has been defined, so that the procedure can get bound into recursive calls.
  670. /colorspacedict 20 dict def
  671.  
  672. /.devcs [
  673.   /DeviceGray /DeviceRGB /DeviceCMYK /DevicePixel
  674. ] readonly def
  675. /currentcolorspace {        % - currentcolorspace <array>
  676.   .currentcolorspace dup type /integertype eq {
  677.     //.devcs exch 1 getinterval
  678.   } if
  679. } odef
  680. currentdict /.devcs .undef
  681.  
  682. /setcolorspace {        % <name|array> setcolorspace -
  683.   dup dup dup type /nametype ne { 0 get } if
  684.   //colorspacedict exch get exec
  685.   dup null eq { pop } { .setcolorspace } ifelse pop
  686. } odef
  687.  
  688. colorspacedict
  689.   dup /DeviceGray { pop 0 setgray null } bind put
  690.   dup /DeviceRGB { pop 0 0 0 setrgbcolor null } bind put
  691.   /setcmykcolor where
  692.    { pop dup /DeviceCMYK { pop 0 0 0 1 setcmykcolor null } bind put
  693.    } if
  694.   /.setcieaspace where
  695.    { pop dup /CIEBasedA { NOCIE { pop 0 setgray null } { dup 1 get .setcieaspace } ifelse } bind put
  696.    } if
  697.   /.setcieabcspace where
  698.    { pop dup /CIEBasedABC { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setcieabcspace } ifelse } bind put
  699.    } if
  700.   /.setciedefspace where
  701.    { pop dup /CIEBasedDEF { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setciedefspace } ifelse } bind put
  702.    } if
  703.   /.setciedefgspace where
  704.    { pop dup /CIEBasedDEFG { NOCIE { pop 0 0 0 1 setcmykcolor null } { dup 1 get .setciedefgspace } ifelse } bind put
  705.    } if
  706.   /.setseparationspace where
  707.    { pop dup /Separation { dup 2 get setcolorspace dup 1 .converttinttransform .setseparationspace } bind put
  708.    } if
  709.   /.setindexedspace where
  710.    { pop dup /Indexed { dup 1 get setcolorspace dup .setindexedspace } bind put
  711.    } if
  712.   /.nullpatternspace [/Pattern] readonly def
  713.   /.setpatternspace where
  714.    { pop dup /Pattern
  715.       { dup type /nametype eq { pop //.nullpatternspace } if
  716.     dup length 1 gt { dup 1 get setcolorspace } if
  717.         dup .setpatternspace
  718.       } bind put
  719.    } if
  720.     % If DeviceN space is included, gs_ll3.ps registers it.
  721.   /.setdevicepixelspace where
  722.    { pop dup /DevicePixel { dup .setdevicepixelspace } bind put
  723.    } if
  724.   currentdict /.nullpatternspace .undef
  725. pop
  726.  
  727. % ------ CIE color rendering ------ %
  728.  
  729. % Define findcolorrendering and a default ColorRendering ProcSet.
  730.  
  731. /findcolorrendering {        % <intentname> findcolorrendering
  732.                 %   <crdname> <found>
  733.   /ColorRendering /ProcSet findresource
  734.   1 index .namestring (.) concatstrings
  735.   1 index /GetPageDeviceName get exec .namestring (.) concatstrings
  736.   2 index /GetHalftoneName get exec .namestring
  737.   concatstrings concatstrings
  738.   dup /ColorRendering resourcestatus {
  739.     pop pop exch pop exch pop true
  740.   } {
  741.     pop /GetSubstituteCRD get exec false
  742.   } ifelse
  743. } odef
  744.  
  745. 5 dict dup begin
  746.  
  747. /GetPageDeviceName {        % - GetPageDeviceName <name>
  748.   currentpagedevice dup /PageDeviceName .knownget {
  749.     exch pop dup null eq { pop /none } if
  750.   } {
  751.     pop /none
  752.   } ifelse
  753. } bind def
  754.  
  755. /GetHalftoneName {        % - GetHalftoneName <name>
  756.   currenthalftone /HalftoneName .knownget not { /none } if
  757. } bind def
  758.  
  759. /GetSubstituteCRD {        % <intentname> GetSubstituteCRD <crdname>
  760.   pop /DefaultColorRendering
  761. } bind def
  762.  
  763. end
  764. % The resource machinery hasn't been activated, so just save the ProcSet
  765. % and let .fixresources finish the installation process.
  766. /ColorRendering exch def
  767.  
  768. % Define setcolorrendering.
  769.  
  770. /.colorrenderingtypes 5 dict def
  771.  
  772. /setcolorrendering {        % <crd> setcolorrendering -
  773.   dup /ColorRenderingType get //.colorrenderingtypes exch get exec
  774. } odef
  775.  
  776. /.setcolorrendering1 where { pop } { (%END CRD) .skipeof } ifelse
  777.  
  778. .colorrenderingtypes 1 {
  779.   dup .buildcolorrendering1 .setcolorrendering1
  780. } .bind put
  781.  
  782. % Note: the value 101 in the next line must be the same as the value of
  783. % GX_DEVICE_CRD1_TYPE in gscrdp.h.
  784. .colorrenderingtypes 101 {
  785.   dup .builddevicecolorrendering1 .setdevicecolorrendering1
  786. } .bind put
  787.  
  788. % Initialize the default CIE rendering dictionary.
  789. % The most common CIE files seem to assume the "calibrated RGB color space"
  790. % described on p. 189 of the PostScript Language Reference Manual,
  791. % 2nd Edition; we simply invert this transformation back to RGB.
  792. mark
  793.    /ColorRenderingType 1
  794. % We must make RangePQR and RangeLMN large enough so that values computed by
  795. % the assumed encoding MatrixLMN don't get clamped.
  796.    /RangePQR [0 0.9505 0 1 0 1.0890] readonly
  797. % This TransformPQR implements a relative colorimetric intent by scaling
  798. % the XYZ values relative to the white and black points.
  799.    /TransformPQR
  800.      [ { 5 1 roll                    % p Ws Bs Wd Bd
  801.          4 {3 get 5 1 roll} repeat   % ws bs wd bd p 
  802.          3 index sub                 % ws bs wd bd p-bs 
  803.          1 index                     % ws bs wd bd p-bs bd
  804.          6 2 roll                    % p-bs bd ws bs wd bd 
  805.          sub                         % p-bs bd ws bs wd-bd 
  806.          5 1 roll                    % wd-bd p-bs bd ws bs  
  807.          sub                         % wd-bd p-bs bd ws-bs  
  808.          4 2 roll                    % bd ws-bs wd-bd p-bs 
  809.          mul                         % bd ws-bs (wd-bd)*(p-bs)
  810.          exch div add                % bd + (wd-bd)*(p-bs)/(ws-bs)
  811.        } bind
  812.        { 5 1 roll
  813.          4 {4 get 5 1 roll} repeat
  814.          3 index sub 1 index 6 2 roll sub 5 1 roll
  815.          sub 4 2 roll mul exch div add
  816.        } bind
  817.        { 5 1 roll
  818.          4 {5 get 5 1 roll} repeat
  819.          3 index sub 1 index 6 2 roll sub 5 1 roll
  820.          sub 4 2 roll mul exch div add
  821.        } bind
  822.      ] readonly
  823.    /RangeLMN [0 0.9505 0 1 0 1.0890] readonly
  824.    /MatrixABC
  825.     [ 3.24063 -0.96893  0.05571
  826.      -1.53721  1.87576 -0.20402
  827.      -0.49863  0.04152  1.05700
  828.     ] readonly
  829.    /EncodeABC [ {0 .max 0.45 exp} bind dup dup] readonly
  830.    /WhitePoint [0.9505 1 1.0890] readonly
  831.     % Some Genoa tests seem to require the presence of BlackPoint.
  832.    /BlackPoint [0 0 0] readonly
  833. .dicttomark setcolorrendering
  834.  
  835. %END CRD
  836.  
  837. % Initialize a CIEBased color space for sRGB.
  838. /CIEsRGB [ /CIEBasedABC
  839.   mark
  840.     /DecodeLMN [ {
  841.       dup 0.03928 le { 12.92321 div } { 0.055 add 1.055 div 2.4 exp } ifelse
  842.     } bind dup dup ] readonly
  843.     /MatrixLMN [
  844.       0.412457 0.212673 0.019334
  845.       0.357576 0.715152 0.119192
  846.       0.180437 0.072175 0.950301
  847.     ] readonly
  848.     /WhitePoint [0.9505 1.0 1.0890] readonly
  849.   .dicttomark readonly
  850. ] readonly def
  851.  
  852. % ------ Painting ------ %
  853.  
  854. % A straightforward definition of execform that doesn't actually
  855. % do any caching.
  856. /.execform1 {
  857.     % This is a separate operator so that the stacks will be restored
  858.     % properly if an error occurs.
  859.   dup /Matrix get concat
  860.   dup /BBox get aload pop
  861.   exch 3 index sub exch 2 index sub rectclip
  862.   dup /PaintProc get
  863.   1 index /Implementation known not {
  864.     1 index dup /Implementation null .forceput readonly pop
  865.   } if
  866.   exec
  867. } .bind odef    % must bind .forceput
  868.  
  869. /.formtypes 5 dict
  870.   dup 1 /.execform1 load put
  871. def
  872.  
  873. /execform {            % <form> execform -
  874.   gsave {
  875.     dup /FormType get //.formtypes exch get exec
  876.   } stopped grestore { stop } if
  877. } odef
  878.  
  879. /.patterntypes 5 dict
  880.   dup 1 /.buildpattern1 load put
  881. def
  882.  
  883. /makepattern {            % <proto_dict> <matrix> makepattern <pattern>
  884.   //.patterntypes 2 index /PatternType get get
  885.   .currentglobal false .setglobal exch
  886.         % Stack: proto matrix global buildproc
  887.   3 index dup length 1 add dict .copydict
  888.   3 index 3 -1 roll exec 3 -1 roll .setglobal
  889.   1 index /Implementation 3 -1 roll put
  890.   readonly exch pop exch pop
  891. } odef
  892.  
  893. /setpattern {            % [<comp1> ...] <pattern> setpattern -
  894.   currentcolorspace 0 get /Pattern ne {
  895.     [ /Pattern currentcolorspace ] setcolorspace
  896.   } if setcolor
  897. } odef
  898.  
  899. % Extend image and imagemask to accept dictionaries.
  900. % We must create .imagetypes and .imagemasktypes outside level2dict,
  901. % and leave some extra space because we're still in Level 1 mode.
  902. systemdict begin
  903. /.imagetypes 5 dict
  904.   dup 1 /.image1 load put
  905. def
  906. /.imagemasktypes 5 dict
  907.   dup 1 /.imagemask1 load put
  908. def
  909. end
  910.  
  911. /.image /image load def
  912. /image {
  913.   dup type /dicttype eq {
  914.     dup /ImageType get //.imagetypes exch get exec
  915.   } {
  916.     //.image
  917.   } ifelse
  918. } odef
  919. currentdict /.image undef
  920.  
  921. /.imagemask /imagemask load def
  922. /imagemask {
  923.   dup type /dicttype eq {
  924.     dup /ImageType get //.imagemasktypes exch get exec
  925.   } {
  926.     //.imagemask
  927.   } ifelse
  928. } odef
  929. currentdict /.imagemask undef
  930.  
  931. end                % level2dict
  932.